home *** CD-ROM | disk | FTP | other *** search
/ Especial Multimedia / Especial Multimedia.iso / Multimed / Presenta / EV2FREE.ZIP / EFREE3.ICZ / ICFILES.BAS < prev    next >
BASIC Source File  |  1995-06-14  |  71KB  |  2,142 lines
  1. 'Declare Function play% Lib "mhen200.vbx" (ByVal Lin$)
  2. 'Declare Sub PlayStop Lib "mhen200.vbx" ()
  3. Declare Function MhASCIIMid% Lib "Muscle.vbx" (a$, ByVal Position%)
  4. Declare Function MhHexStrInt$ Lib "Muscle.vbx" (ByVal Fmt%, IntVal%)
  5. Declare Function MhHexValInt% Lib "Muscle.vbx" (Hexa$)
  6. Declare Function MhReplaceChar$ Lib "Muscle.vbx" (Lin$, ByVal OldChar%, ByVal NewChar%)
  7. Declare Function MhSpecToken$ Lib "Muscle.vbx" (ByVal Which%, Spec$)
  8. Declare Function MhWinDir$ Lib "Muscle.vbx" ()
  9. 'Declare Function cvc@ Lib "Muscle.vbx" (ByVal Lin$)
  10. 'Declare Function cvd# Lib "Muscle.vbx" (ByVal Lin$)
  11. Declare Function cvi% Lib "Muscle.vbx" (ByVal Lin$)
  12. 'Declare Function cvl& Lib "Muscle.vbx" (ByVal Lin$)
  13. 'Declare Function cvs! Lib "Muscle.vbx" (ByVal Lin$)
  14. 'Declare Function mkc$ Lib "Muscle.vbx" (a@)
  15. 'Declare Function mkd$ Lib "Muscle.vbx" (a#)
  16. 'Declare Function mki$ Lib "Muscle.vbx" (ByVal a%)
  17. 'Declare Function mkl$ Lib "Muscle.vbx" (ByVal l&)
  18. 'Declare Function MKS$ Lib "Muscle.vbx" (a!)
  19. Declare Function SetParent% Lib "User" (ByVal hWndChild%, ByVal hWndNewParent%)
  20.  
  21. '***********************************
  22.  
  23. ' include this module with your Everest external program
  24. ' it provides the communications between Everest and your program
  25.  
  26. ' your program acts as a DDE server
  27. ' Everest is the DDE destination
  28.  
  29. '***********************************
  30.  
  31. ' put type declarations here
  32.  
  33. Type externtype     ' header for execute strings
  34.   sub As String * 5 ' chr$(0) substitute char
  35.   wind As Integer   ' window number
  36.   rout As Integer   ' routine
  37.   op As Integer     ' operation
  38.   obj As Integer    ' object
  39.   ind As Integer    ' index number
  40.   hwn As Integer    ' window handle
  41.   opt As Long       ' o$ pointer
  42.   atx As Single     ' drag drop loc X
  43.   aty As Single     ' drag drop loc Y
  44.   stl As Long       ' string length
  45.   mid As String * 1 ' message id
  46.   err As Integer    ' error code (-1 means no error)
  47. End Type
  48.  
  49. Type ext36type      ' continguous memory buffer for externtype
  50.   x As String * 36
  51. End Type
  52.  
  53. Type type242
  54.   chr242 As String * 1
  55.   i As Integer
  56. End Type
  57. Type type242s
  58.   s As String * 3
  59. End Type
  60. Type typecvi
  61.   chr242 As String * 1
  62.   s As String * 2
  63. End Type
  64. Type type243
  65.   chr243 As String * 1
  66.   l As Long
  67. End Type
  68. Type type243s
  69.   s As String * 5
  70. End Type
  71. Type type244
  72.   chr244 As String * 1
  73.   s As Single
  74. End Type
  75. Type type244s
  76.   s As String * 5
  77. End Type
  78. Type type245
  79.   chr245 As String * 1
  80.   d As Double
  81. End Type
  82. Type type245s
  83.   s As String * 9
  84. End Type
  85. Type type246
  86.   chr246 As String * 1
  87.   c As Currency
  88. End Type
  89. Type type246s
  90.   s As String * 9
  91. End Type
  92.  
  93. '*************************************
  94.  
  95. ' put constant declarations here
  96.  
  97. Const yes = -1
  98. Const chr124$ = "|"
  99. Const headlen1% = 37      ' bytes in externtype + 1
  100.  
  101. '**************************************
  102.  
  103. ' allocate typed vars here
  104.  
  105. Dim extt As externtype
  106. Dim ext36 As ext36type
  107. Global t242 As type242, t242s As type242s
  108. Global t243 As type243, t243s As type243s
  109. Global t244 As type244, t244s As type244s
  110. Global t245 As type245, t245s As type245s
  111. Global t246 As type246, t246s As type246s
  112. Global tcvi As typecvi
  113.  
  114. ' *************************************
  115.  
  116. ' declare global variables here
  117.  
  118. Global zr%
  119. Global eq$(127), eqin%, eqout%
  120. Global objids$(-2 To 9, 8), idmap$(8), objn$(8)
  121. Global atts$, attpick$, oats$(8), roats$(8), support$(8), help$(8)
  122. Global tags(), usedtags$
  123. Global mainpath$
  124.  
  125. Sub ackx ()
  126. ' if processing of incoming message will require more
  127. ' than 3 seconds, then before beginning processing
  128. ' call this routine to acknowledge receipt of message
  129.  
  130.   extt.err = zr%: zr% = yes                     ' return error code (if any)
  131.   extt.stl = -2                                 ' acknowledgment flag for no change
  132.   LSet ext36 = extt                             ' copy to ext36
  133.   em$ = ext36.x
  134.  
  135. ' now substitute for chr$(0) due to DDE inability to transmit chr$(0)
  136. ' since em$ is short, a valid subchar will always be available
  137.  
  138.   For subchar% = 254 To 1 Step -1               ' look for 0 substitute candidate
  139.     If InStr(em$, Chr$(subchar%)) = 0 Then Exit For  ' this one not elsewhere in string
  140.   Next
  141.   Mid$(em$, 1, 5) = CStr(-subchar%) + "     "   ' put sub char at start of em$
  142.   em$ = MhReplaceChar$(em$, 0, subchar%)        ' quickest
  143.  
  144. ' send reply (Everest is waiting for this)
  145.  
  146.   icfiles.Data.Text = em$
  147.  
  148. End Sub
  149.  
  150. Sub copx (op%, obj%, con As Control, buf$, pt&, vary)
  151. ' "control" operations to/from disk
  152. ' op% = 0: concatenate attributes into buf$
  153. '     = 1: parse buf$ into attributes
  154. '     = 2: control attributes to InfoGrid cells
  155. '     = 3: InfoGrid cell to control attribute
  156. '     = 8: same as 0, but skip ID attrib
  157. '     = 9; same as 1, but skip ID attrib
  158. '     =16: same as 0, but instance props only
  159. '     =17: same as 1, but instance props only
  160. '     =32: same as 0, but return attrib for buf$ in vary
  161. '     =33: same as 1, but set attrib buf$ only = to vary
  162. '     =64: same as 0, but non-instance props only
  163. '     =65: same as 1, but non-instance props only
  164. '     128 bit = form globals
  165. Static lookat%, zaflag%
  166.   On Error GoTo ignorecop   ' ignore error on next line
  167.   conindex% = con.Index     ' in case object does not have an .Index
  168.  
  169.   On Error GoTo whoops
  170.   tg$ = con.Tag: If Len(tg$) = 1 Then tagval% = Asc(tg$) Else tagval% = Val(tg$)
  171.  
  172.   justone% = (op% And 32)               ' reading/setting one attrib only
  173.   'Frm% = (op% And 128)                  ' handling screen form globals
  174.   If (op% And 64) Then                  ' which group of attributes?
  175.     Which% = 1                          ' non-instance attribs only
  176.     xxat% = InStr(oats$(obj%), "XX")
  177.   ElseIf (op% And 16) Then
  178.     Which% = -1                         ' instance attribs only
  179.   Else
  180.     Which% = 0                          ' else ignore instance
  181.   End If
  182.  
  183.   Select Case (op% And 7)
  184.   Case 0, 2                             ' from properties
  185.     If justone% Then                    ' get just one attrib
  186.       at$ = buf$                        ' buf$ has single attrib we want
  187.       maxx% = 2
  188.     Else
  189.       inst% = yes                       ' instance attribs always start
  190.       oat$ = oats$(obj%)                ' oats$() has all attribs
  191.       If extt.wind > 0 And zaflag% = 0 Then oat$ = oat$ + roats$(obj%)
  192.       at$ = Left$(oat$, 2)
  193.       maxx% = Len(oat$)
  194.     End If
  195.  
  196.     For x% = 1 To maxx% Step 2
  197.       cviat% = cvi(at$)
  198.       Select Case Asc(at$)
  199.       Case Is < 65
  200.         Select Case cviat%
  201.         Case cvi("1d")
  202.           vary = con.Drive
  203.         Case cvi("1i")    ' .CurrentItem
  204.           vary = con.List(con.ListIndex)
  205.         Case cvi("1p")
  206.           vary = con.Pattern
  207.         Case cvi("2p")
  208.           vary = con.Path
  209.         End Select
  210.       Case Is < 70
  211.         Select Case cviat%
  212.         'Case 26177 '"Af"                   ' in tags now 08-16-93
  213.         '  vary = con.Animation
  214.         'Case 26945 '"Ai"                     ' write only
  215.         '  vary = con.Additem
  216.         Case 27201 '"Aj"
  217.           vary = ""
  218.           For Y% = con.ListCount To 1 Step -1
  219.             vary = Chr$(255) + con.List(Y% - 1) + vary  ' use 255 as sep, I guess ok
  220.             If Len(vary) > 32000 Then Exit For
  221.           Next
  222.         'Case 28225 '"An"
  223.         '  vary = Con.Action                ' a write-only property
  224.         Case 29761 '"At"
  225.           vary = con.Alignment
  226.         Case 30017 '"Au"
  227.           vary = con.AutoSize
  228.         Case 30529 '"Aw"
  229.           If obj% = 50 Then
  230.             GoSub intags
  231.           Else
  232.             vary = con.AutoRedraw
  233.           End If
  234.         ''Case 24898 '"Ba"
  235.           ''vary = con.BoxAlignment
  236.         Case 25410 '"Bc"
  237.           vary = con.BackColor
  238.         ''Case 26946 '"Bi"
  239.           ''vary = con.BevelSizeInner
  240.         ''Case 27202 '"Bj"
  241.           ''vary = con.BevelStyleInner
  242.         Case 27970 '"Bm"
  243.           vary = con.Top + con.Height
  244.         Case 28482 '"Bo"
  245.           vary = con.BorderColor
  246.         Case 29250 '"Br"
  247.           vary = con.BorderWidth
  248.         Case 29506, 29519 '"Bs", "Os"
  249.           vary = con.BorderStyle
  250.         ''Case 29762 '"Bt"
  251.           ''vary = con.BorderType
  252.         ''Case 30274 '"Bv"
  253.           ''vary = con.BevelSizeInside
  254.         ''Case 30530 '"Bw"
  255.           ''vary = con.BevelStyleInside
  256.         ''Case 30786 '"Bx"
  257.           ''vary = con.BoxSize
  258.         ''Case 31042 '"By"
  259.           ''vary = con.BevelStyle
  260.         ''Case 31298 '"Bz"
  261.           ''vary = con.BevelSize
  262.         ''Case 25411 '"Cc"
  263.           ''vary = con.TextColor
  264.         'Case 25667 '"Cd"
  265.         '  vary = con.Command
  266.         ''Case 27715 '"Cl"
  267.           ''vary = con.Cols
  268.         Case 28227 '"Cn"
  269.           vary = con.Caption
  270.         ''Case 29251 '"Cr"
  271.           ''vary = con.FontEscapement / 10
  272.         ''Case 29507 '"Cs"
  273.           ''vary = con.Class
  274.         Case 31043 '"Cy"
  275.           '''If conindex% > 0 Then
  276.           '''  Call objmgrx(0, (extt.wind), obj%, conindex%, -1!, -1!, -2, "")
  277.           '''Else
  278.             '''zr% = -246
  279.           '''End If
  280.           Call objmgrx(0, (extt.wind), obj%, (extt.ind), -1!, -1!, -2, "")
  281.           vary = zr%: zr% = yes
  282.         'Case cvi("Dg")
  283.         '  vary = con.Drag
  284.         ''Case 27204 '"Dj"
  285.           ''vary = con.DeviceID
  286.         Case 27972 '"Dm"
  287.           vary = con.DragMode
  288.         ''Case 29764 '"Dt"
  289.           ''vary = con.DeviceType
  290.         Case 31044 '"Dy"
  291.           '''If conindex% > 0 Then
  292.             '''Call objmgrx(2, (extt.wind), obj%, conindex%, -1!, -1!, -2, "")
  293.           '''Else
  294.             '''zr% = -246
  295.           '''End If
  296.           Call objmgrx(2, (extt.wind), obj%, (extt.ind), -1!, -1!, -2, "")
  297.           vary = zr%: zr% = yes
  298.         Case 28229 '"En"
  299.           vary = con.Enabled
  300.         Case 25925 '"Ee"
  301.           'vary = con.Execute     ' vb3
  302.         Case Else
  303.           GoSub intags
  304.         End Select
  305.       Case Is < 78
  306.         Select Case cviat%
  307.         Case 12614 '"F1"
  308.           vary = con.FontBold
  309.         Case 12870 '"F2"
  310.           vary = con.FontItalic
  311.         ''Case 13126 '"F3"
  312.           ''vary = con.FontStyle
  313.         Case 13382 '"F4"
  314.           vary = con.FontStrikethru
  315.         Case 13638 '"F5"
  316.           vary = con.FontTransparent
  317.         Case 13894 '"F6"
  318.           vary = con.FontUnderline
  319.         ''Case 25158 '"Fb"
  320.           ''vary = con.FillBarColor
  321.         Case 25414 '"Fc"
  322.           vary = con.ForeColor
  323.         ''Case 25670 '"Fd"
  324.           ''vary = con.BeginFade
  325.         'Case 25926 '"Fe"                in tag now, 08-16-93
  326.         '  vary = con.FileName
  327.         Case 26182 '"Ff"
  328.           GoSub intags
  329.           If Len(vary) = 0 Then timformat% = 2 Else timformat% = Val(vary)
  330.         'Case 26438 '"Fg"
  331.         '  vary = con.FoundString
  332.         Case 26950 '"Fi"
  333.           vary = con.FillColor
  334.         Case 28230 '"Fn"
  335.           vary = con.FontName
  336.         ''Case 28486 '"Fo"
  337.           ''vary = con.EndFade
  338.         Case 29510 '"Fs"
  339.           vary = con.FontSize
  340.         ''Case 29766 '"Ft"
  341.           ''vary = con.Format
  342.         ''Case 30022 '"Fu"
  343.           ''vary = con.FullScreen
  344.         ''Case 30278 '"Fv"
  345.           ''vary = con.FillValue
  346.         ''Case 30790 '"Fx"
  347.           ''vary = con.FoundIndex
  348.         Case 31046 '"Fy"
  349.           vary = con.FillStyle
  350.         ''Case 31302 '"Fz"
  351.           ''vary = con.Focus
  352.         ''Case 28743 '"Gp"
  353.           ''vary = con.Group
  354.         ''Case 29511 '"Gs"
  355.           ''vary = con.GaugeStyle
  356.         ''Case 25672 '"Hd"
  357.           ''vary = con.StateButton
  358.         ''Case 29512  '"Hs"
  359.           ''If extt.wind > 0 Then
  360.             ''vary = con.HeadingSize
  361.           ''Else
  362.             ''GoSub intags
  363.           ''End If
  364.         Case 29768 '"Ht"
  365.           vary = con.Height \ Screen.TwipsPerPixelY
  366.         Case 30536 '"Hw"
  367.           vary = con.hWnd
  368.         Case 31304 '"Hz"
  369.           vary = con.hDC
  370.         ''Case 24905 '"Ia"
  371.           ''vary = con.ColAlignment
  372.         ''Case 25161 '"Ib"
  373.           ''vary = con.InnerBottom
  374.         Case 25417 '"Ic"
  375.           vary = con.ListCount
  376.         Case 25673 '"Id"
  377.           If (op% And 8) = 0 Then GoSub intags Else vary = ""
  378.         Case 25929 '"Ie"
  379.           vary = con.List(lookat%)
  380.         Case 26953 '"Ii"
  381.           vary = con.ListIndex
  382.         ''Case 27465 '"Ik"
  383.           ''vary = con.TextColor
  384.         ''Case 27721 '"Il"
  385.           ''vary = con.InnerLeft
  386.         ''Case 28745 '"Ip"
  387.           ''vary = con.InnerTop
  388.         ''Case 29257 '"Ir"
  389.           ''vary = con.InnerRight
  390.         ''Case 29513 '"Is"
  391.           ''vary = con.EndLoop
  392.         ''Case 29769 '"It"
  393.           ''vary = con.Mask
  394.         ''Case 31305 '"Iz"
  395.           ''vary = con.Indent
  396.         ''Case 28746
  397.           ''vary = con.JumpCursor
  398.         Case 24908 '"La"
  399.           vary = lookat%
  400.         ''Case 25420 '"Lc"
  401.           ''vary = con.LightColor
  402.         ''Case 25676 '"Ld"
  403.           ''vary = con.LastAdded
  404.         ''Case 29260 '"Lr"
  405.           ''vary = con.FontOrientation / 10
  406.         Case 29516 '"Ls"
  407.           vary = con.LargeChange
  408.         Case 29772 '"Lt"
  409.           vary = con.Left \ Screen.TwipsPerPixelX
  410.         ''Case 25677 '"Md"
  411.           ''vary = con.MaxDrop
  412.         Case 27725 '"Ml"
  413.           vary = con.MultiLine
  414.         Case 28237 '"Mn"
  415.           vary = con.Min
  416.         Case 28749 '"Mp"
  417.           vary = con.MousePointer
  418.         Case 30285 '"Mv"
  419.           vary = CStr(con.Left \ Screen.TwipsPerPixelX) + "," + CStr(con.Top \ Screen.TwipsPerPixelY) + "," + CStr(con.Width \ Screen.TwipsPerPixelX) + "," + CStr(con.Height \ Screen.TwipsPerPixelY)
  420.         Case 30797 '"Mx"
  421.           vary = con.Max
  422.         Case Else
  423.           GoSub intags
  424.         End Select
  425.       Case Is < 84
  426.         Select Case cviat%
  427.         ''Case 28750 '"Np"
  428.           ''vary = con.NormalCursor
  429.         ''Case 29263 '"Or"
  430.           ''vary = con.Orientation
  431.         Case 12368 '"P0"
  432.           vary = con.Picture
  433.           If vary <> 0 Then
  434.             vary = ".sp0": GoSub picfyle
  435.             SavePicture con.Picture, sep$
  436.           End If
  437.         ''Case 12624 '"P1"
  438.           ''vary = con.PictureDown
  439.           ''If vary <> 0 Then
  440.             ''vary = ".sp1": GoSub picfyle
  441.             ''SavePicture con.PictureDown, sep$
  442.           ''End If
  443.         ''Case 12880 '"P2"
  444.           ''vary = con.PictureGreyed
  445.           ''If vary <> 0 Then
  446.             ''vary = ".sp2": GoSub picfyle
  447.             ''SavePicture con.PictureGreyed, sep$
  448.           ''End If
  449.         ''Case 13136 '"P3"
  450.           ''vary = con.PictureChecked
  451.           ''If vary <> 0 Then
  452.             ''vary = ".sp3": GoSub picfyle
  453.             ''SavePicture con.PictureChecked, sep$
  454.           ''End If
  455.         ''Case 13392 '"P4"
  456.           ''vary = con.PictureUnChecked
  457.           ''If vary <> 0 Then
  458.             ''vary = ".sp4": GoSub picfyle
  459.             ''SavePicture con.PictureUnChecked, sep$
  460.           ''End If
  461.         ''Case 13648 '"P5"
  462.           ''vary = con.PicturePressed
  463.           ''If vary <> 0 Then
  464.             ''vary = ".sp5": GoSub picfyle
  465.             ''SavePicture con.PicturePressed, sep$
  466.           ''End If
  467.         ''Case 13904 '"P6"
  468.           ''vary = con.PictureUp
  469.           ''If vary <> 0 Then
  470.             ''vary = ".sp6": GoSub picfyle
  471.             ''SavePicture con.PictureUp, sep$
  472.           ''End If
  473.         Case 14672 '"P9"
  474.           If con.AutoRedraw Then
  475.             vary = ".sp9": GoSub picfyle
  476.             SavePicture con.Picture, sep$
  477.           End If
  478.         ''Case 25424 '"Pc"
  479.           ''vary = con.PassChar
  480.         ''Case 27728 '"Pl"
  481.           ''vary = con.Protocol
  482.         ''Case 29008 '"Pq"
  483.           ''vary = con.PopupCursor
  484.         Case 29264 '"Pr"
  485.           vary = con.Interval / 1000
  486.         ''Case 29776 '"Pt"
  487.           ''vary = con.Position
  488.         ''Case 31056 '"Py"
  489.           ''If extt.wind = 0 Then
  490.             ''GoSub intags
  491.           ''Else
  492.             ''vary = con.Play
  493.           ''End If
  494.         Case 26706 '"Rh"
  495.           vary = con.Left \ Screen.TwipsPerPixelX + con.Width \ Screen.TwipsPerPixelX
  496.         Case 28498 '"Ro"
  497.           If extt.wind = 0 Then
  498.             GoSub intags
  499.           Else
  500.             vary = con.ReadOnly
  501.           End If
  502.         ''Case 30546 '"Rw"
  503.           ''vary = con.Rows
  504.         Case 25171 '"Sb"
  505.           vary = con.ScrollBars
  506.         ''Case 25427 '"Sc"
  507.           ''vary = con.ShadowColor
  508.         ''Case 25683 '"Sd"
  509.           ''vary = con.Device
  510.         Case 26707 '"Sh"
  511.           vary = con.Shape
  512.         ''Case 26963 '"Si"
  513.           ''vary = con.Silent
  514.         ''Case 27475 '"Sk"
  515.           ''vary = con.SourceDoc
  516.         Case 27731 '"Sl"
  517.           vary = con.Style
  518.         ''Case 27987 '"Sm"
  519.           ''vary = con.SourceItem
  520.         ''Case 28499 '"So"
  521.           ''vary = con.Sound
  522.         Case 28755 '"Sp"
  523.           vary = con.SmallChange
  524.         Case 29011 '"Sq"
  525.           If obj% = 50 Then
  526.             'wind% = Val(con.Parent.Tag)
  527.             'vary = CStr(Ls(wind%).ScaleMode) + "," + CStr(Ls(wind%).ScaleLeft) + "," + CStr(Ls(wind%).ScaleTop) + "," + CStr(Ls(wind%).ScaleWidth) + "," + CStr(Ls(wind%).ScaleHeight)
  528.             GoSub intags
  529.           Else
  530.             vary = CStr(con.ScaleMode) + "," + CStr(con.ScaleLeft) + "," + CStr(con.ScaleTop) + "," + CStr(con.ScaleWidth) + "," + CStr(con.ScaleHeight)
  531.           End If
  532.         Case 29267 '"Sr"
  533.           vary = con.Sorted
  534.         Case 29779 '"St"
  535.           vary = con.Value
  536.         ''Case 30547 '"Sw"
  537.           ''vary = con.ServerShow
  538.         Case 30803 '"Sx"
  539.           'If TypeOf con Is MhInput Then
  540.             'vary = Mid(con.Text, con.SelStart + 1, con.SelLength)
  541.             vary = con.SelText
  542.           'End If
  543.         ''Case 31059 '"Sy"
  544.           ''vary = con.ServerType
  545.         ''Case 31315 '"Sz"
  546.           ''vary = con.ServerClass
  547.         Case 10323 '"S("
  548.           vary = con.SelStart
  549.         Case 10579 '"S)"
  550.           vary = con.SelLength
  551.         Case Else
  552.           GoSub intags
  553.         End Select
  554.       Case Else
  555.         Select Case cviat%
  556.         ''Case 12628 '"T1"
  557.           ''vary = con.HighColor
  558.         ''Case 12884 '"T2"
  559.           ''vary = con.SelectedColor
  560.         ''Case 24916 '"Ta"
  561.           ''y% = con.ListCount
  562.           ''sep$ = String$(y%, "O")
  563.           ''For y% = y% - 1 To 0 Step -1
  564.             ''If con.Tagged(y%) Then Mid$(sep$, y% + 1) = "X"
  565.           ''Next
  566.           ''vary = sep$: sep$ = ""
  567.         ''Case 25428 '"Tc"
  568.           ''vary = con.SelectedCount
  569.         ''Case 25684 '"Td"
  570.           ''vary = con.Tagged(lookat%)
  571.         Case 26452 '"Tg"
  572.           vary = con.Tag
  573.         Case 26964 '"Ti"
  574.           vary = con.TopIndex
  575.         ''Case 27732 '"Tl"
  576.           ''vary = con.TextLen
  577.         Case 28500 '"To"
  578.           vary = con.TabIndex
  579.         Case 28756 '"Tp"
  580.           vary = con.Top \ Screen.TwipsPerPixelY
  581.         Case 29524 '"Ts"
  582.           vary = con.TabStop
  583.         Case 29780 '"Tt"
  584.           vary = con.Text
  585.         Case 31060 '"Ty"
  586.           vary = con.MultiSelect
  587.         Case 24918 '"Va"
  588.           vary = con.Value
  589.         ''Case 25174 '"Vb"
  590.           ''vary = con.Verb
  591.         Case 25942 '"Ve"
  592.           vary = con.Visible
  593.         ''Case 29782 '"Vt"
  594.           ''vary = con.VAlignment
  595.         Case 26711 '"Wh"
  596.           vary = con.Width \ Screen.TwipsPerPixelX
  597.         ''Case 29271 '"Wr"
  598.           ''vary = con.WallPaper
  599.         Case 30551 '"Ww"
  600.           vary = con.WordWrap
  601.         Case 22616 '"XX"                       ' end of instance info flag
  602.           If Which% < 0 Then Exit For
  603.           vary = nul$
  604.           inst% = 0: GoTo skip
  605.         Case 22873 '"YY"                       ' end of displayable attribs
  606.           GoTo skip
  607.         Case 24922 '"Za"
  608.           zaflag% = yes
  609.           Call copx(64, obj%, con, buf2$, waste&, vary)
  610.           zaflag% = 0
  611.           vary = buf2$
  612.         Case 28762 '"Zp"                       ' special internal code to read & set ZOrder without updating .Tag
  613.           at$ = "Zo": GoSub intags
  614.           If Len(vary) Then
  615.             If Val(vary) >= 0 Then con.ZOrder Val(vary)
  616.           End If
  617.           at$ = "Zp"
  618.         Case Else
  619.           GoSub intags
  620.         End Select
  621.       End Select
  622.  
  623.       If VarType(vary) <> 8 Then
  624.       ElseIf Len(vary) = 0 Then       ' init empties for certain attribs
  625.         If InStr("ArBuCbCoEnMaMiNmRoSsTbVe", at$) Then
  626.           vary = -1
  627.         ElseIf InStr("AcAlAuAwAzCmFuFyKoLuMnMsMxPyReRlRsSaSeSiWlWpWsWtZo", at$) Then
  628.           vary = 0
  629.         ElseIf cviat% = 29624 Then '"Pr"
  630.           vary = "1"
  631.         ElseIf cviat% = 25936 Then '"Pe"
  632.           vary = "Y"
  633.         ElseIf InStr("FfWb", at$) Then
  634.           vary = "2"
  635.         ElseIf InStr("EtIy", at$) Then
  636.           vary = "3"
  637.         ElseIf cviat% = 25673 Then '"Id"
  638.           vary = conindex%
  639.         ElseIf cviat% = 29512 Then '"Hs"
  640.           vary = 10
  641.         End If
  642.       End If
  643.  
  644.       If Which% > 0 Then                      ' concat non-instance only
  645.         If inst% = 0 Then buf$ = buf$ + at$ + fnCompX$(vary)
  646.       ElseIf justone% Then
  647.         'Call sumerr(zr%)                     commented out 7-9-93 since prevents program code line from being displayed with error message
  648.         Exit Sub                              ' for speed
  649.       Else                                    ' concat into one string
  650.         buf$ = buf$ + at$ + fnCompX$(vary)
  651.       End If
  652. skip:
  653.       at$ = Mid$(oat$, x% + 2, 2)       ' prep for next attrib (faster down here)
  654.     Next
  655.  
  656.     If justone% = 0 Then buf$ = buf$ + "ZZ"                ' end attributes flag
  657.  
  658. ' ******************************************************************
  659. ' ********************** set attributes below **********************
  660. ' ******************************************************************
  661.  
  662.   Case 1, 3                             ' set attrib values
  663.     moveit% = 0  ': tagset% = 0
  664.     redolist% = 0
  665.     sys15% = extt.wind                  ' faster
  666.     If pt& <= 0 Then pt& = 1
  667.     If justone% Then                    ' set just 1
  668.       x% = 1: maxx% = 1
  669.     Else
  670.       x% = 1: maxx% = 999
  671.     End If
  672.  
  673.     For x% = 1 To maxx% Step 2
  674.       If justone% Then                  ' vary passed in as parameter
  675.         at$ = Left$(buf$, 2)
  676.  
  677.         If Len(at$) = 0 Then
  678.           GoTo skip2   ' just in case
  679.         ElseIf VarType(vary) <> 8 Then
  680.         ElseIf InStr(ynat$, at$) Then
  681.           If Len(vary) = 0 Then
  682.           ElseIf (Asc(vary) Or 32) = 121 Then
  683.             vary = -1
  684.           ElseIf (Asc(vary) Or 32) = 110 Then
  685.             vary = 0
  686.           Else
  687.             vary = CInt(Val(vary))
  688.           End If
  689.         ElseIf InStr("AcAnAtBaBjBsBtBwByEtF3FdFfFoFyGsHaIaIsIyNtOrOsSbSeShSlSyTyVbVtWrWsZo", at$) Then
  690.           vary = CInt(Val(vary))
  691.         ElseIf InStr("EvJvRv", at$) Then
  692.           vary = RTrim$(vary)
  693.         ElseIf InStr(COAT$, at$) Then
  694.           vary = FixColorx&(vary)
  695.         End If
  696.         If Which% > 0 Then                  ' non-instance attribs only
  697.           If InStr(oats$(obj%), at$) < xxat% Then GoTo skip2
  698.         End If
  699.         cviat% = cvi(at$)
  700.       Else
  701.         at$ = Mid$(buf$, pt&, 2): pt& = pt& + 2
  702.         cviat% = cvi(at$)
  703.         If cviat% = 23130 Or Len(at$) = 0 Then Exit For   ' "ZZ"
  704.         
  705.         'vary = fnExt(buf$, pt&)
  706.         typ% = Asc(Mid$(buf$, pt&, 1)): pt& = pt& + 1
  707.         If typ% < 240 Then                  ' short string
  708.           vary = Mid(buf$, pt&, typ%)
  709.           pt& = pt& + typ%
  710.         ElseIf typ% = 240 Then              ' empty
  711.           vary = Empty
  712.         ElseIf typ% = 250 Then              ' null
  713.           vary = ""
  714.         ElseIf typ% = 251 Then              ' 0
  715.           vary = 0
  716.         ElseIf typ% = 242 Then              ' int
  717.           t242s.s = Mid$(buf$, pt& - 1, 3): LSet t242 = t242s: vary = t242.i
  718.           pt& = pt& + 2
  719.         ElseIf typ% = 243 Then              ' long
  720.           t243s.s = Mid$(buf$, pt& - 1, 5): LSet t243 = t243s: vary = t243.l
  721.           pt& = pt& + 4
  722.         ElseIf typ% = 244 Then              ' single
  723.           t244s.s = Mid$(buf$, pt& - 1, 5): LSet t244 = t244s: vary = t244.s
  724.           pt& = pt& + 4
  725.         ElseIf typ% = 245 Then              ' double
  726.           t245s.s = Mid$(buf$, pt& - 1, 9): LSet t245 = t245s: vary = t245.d
  727.           pt& = pt& + 8
  728.         ElseIf typ% = 248 Then              ' long string
  729.           typ% = MhHexValInt%(Mid$(buf$, pt&, 4))
  730.           vary = Mid(buf$, pt& + 4, typ%)
  731.           pt& = pt& + typ% + 4
  732.         ElseIf typ% = 249 Then              ' very long string
  733.           chars& = CLng(Mid$(buf$, pt&, 5))
  734.           vary = Mid(buf$, pt& + 5, chars&)
  735.           pt& = pt& + chars& + 5
  736.         ElseIf typ% = 246 Then              ' currency
  737.           t246s.s = Mid$(buf$, pt& - 1, 9): LSet t246 = t246s: vary = t246.c
  738.           pt& = pt& + 8
  739.         ElseIf typ% = 247 Then              ' date
  740.           vary = Mid(buf$, pt&, 8)
  741.           pt& = pt& + 8
  742.         End If
  743.  
  744.         If Which% > 0 Then                  ' non-instance attribs only
  745.           If InStr(oats$(obj%), at$) < xxat% Then GoTo skip2
  746.         End If
  747.       End If
  748.  
  749.       Select Case Asc(at$)
  750.       Case Is < 65
  751.         Select Case cviat%
  752.         Case cvi("1d")
  753.           con.Drive = vary
  754.         Case cvi("1p")
  755.           con.Pattern = vary
  756.         Case cvi("2p")
  757.           con.Path = vary
  758.         End Select
  759.       Case Is < 67
  760.         Select Case cviat%
  761.         ''Case 26177 '"Af"
  762.           ''z9% = con.Play: con.Play = 0    ' changes legal only when stopped
  763.           ''con.Animation = ""              ' clears old one (if any)
  764.           ''aas% = (LCase$(Right$(vary, 4)) = ".aas")  ' AA script flag
  765.           ''If InStr(vary, "{") = 0 Then con.Animation = FixDriveV$(vary)
  766.           ''con.Play = z9%
  767.           ''GoSub settag
  768.         Case 26945 '"Ai"
  769.           con.AddItem vary
  770.         ''Case 28225 '"An"
  771.           ''con.Action = vary
  772.           ''GoSub settag
  773.         Case 29761 '"At"
  774.           If con.Alignment <> vary Then
  775.             '''If TypeOf con Is MhInput Then
  776.               '''GoSub dumfocus
  777.               '''con.Alignment = vary
  778.               '''ignoreerr% = yes: con.SetFocus : ignoreerr% = 0
  779.             '''Else
  780.               con.Alignment = vary
  781.             '''End If
  782.           End If
  783.         Case 30017 '"Au"
  784.           If vary <> con.AutoSize Then
  785.             con.AutoSize = vary
  786.             '''If sys15% = -1 Then Call fmgr2(1, 0, obj%, conindex%, con)           ' refresh all windows
  787.           End If
  788.         Case 30529 '"Aw"
  789.           If obj% = 50 Then
  790.             GoSub settag
  791.           Else
  792.             con.AutoRedraw = vary
  793.           End If
  794.         ''Case 24898 '"Ba"
  795.           ''con.BoxAlignment = vary
  796.         Case 25410 '"Bc"
  797.           If con.BackColor <> vary Then con.BackColor = vary
  798.           '''If (op% And 128) Then
  799.             '''If Ls(extt.wind).BackColor <> vary Then Ls(extt.wind).BackColor = vary
  800.           '''End If
  801.         Case 26178 '"Bf"
  802.           ''If InStr(vary, "{") = 0 Then
  803.             ''con.Picture = LoadPicture(FixDriveVx$(vary))
  804.             ''con.Parent.PicBin.Picture = con.Picture
  805.           ''End If
  806.           ''GoSub settag
  807.         ''Case 26946 '"Bi"
  808.           ''If con.BevelSizeInner <> vary Then
  809.             ''con.BevelSizeInner = vary
  810.           ''End If
  811.         ''Case 27202 '"Bj"
  812.           ''con.BevelStyleInner = vary
  813.         Case 27970 '"Bm"
  814.           con.Height = vary - con.Top
  815.         Case 28482 '"Bo"
  816.           If con.BorderColor <> vary Then con.BorderColor = vary
  817.         '''Case 28738 '"Bp"
  818.           '''If extt.wind = 0 Then
  819.             '''If LCase$(vary) = "(clear)" Then
  820.               '''Ls(0).Picture = LoadPicture("")
  821.             '''ElseIf InStr(vary, "{") Then
  822.             '''Else 'If LCase$(Right$(vary, 4)) = ".bmp" Then
  823.               '''Ls(0).Picture = LoadPicture(FixDriveV$(vary))
  824.             '''End If
  825.           '''End If
  826.           '''GoSub settag
  827.         Case 29250 '"Br"
  828.           con.BorderWidth = vary
  829.         Case 29506 '"Bs"
  830.           If con.BorderStyle <> vary Then
  831.             con.BorderStyle = vary
  832.           End If
  833.         ''Case 29762 '"Bt"
  834.           ''If con.BorderType <> vary Then
  835.             ''con.BorderType = vary
  836.           ''End If
  837.         ''Case 30274 '"Bv"
  838.           ''con.BevelSizeInside = vary
  839.         ''Case 30530 '"Bw"
  840.           ''con.BevelStyleInside = vary
  841.         ''Case 30786 '"Bx"
  842.           ''con.BoxSize = vary
  843.         ''Case 31042 '"By"
  844.           ''con.BevelStyle = vary
  845.         ''Case 31298 '"Bz"
  846.           ''con.BevelSize = vary
  847.         Case Else
  848.           GoSub settag
  849.         End Select
  850.       Case Is < 70
  851.         Select Case cviat%
  852.         ''Case 25411 '"Cc"
  853.           ''If con.TextColor <> vary Then con.TextColor = vary
  854.         ''Case 27715 '"Cl"
  855.           ''con.Cols = vary
  856.           ''con.Parent.PicBin.Cols = vary
  857.         Case 28227 '"Cn"
  858.           If con.Caption <> vary Then con.Caption = vary
  859.         ''Case 29251 '"Cr"
  860.           ''con.FontEscapement = vary * 10
  861.         ''Case 29507 '"Cs"
  862.           ''con.Class = vary
  863.         Case 31043 '"Cy"
  864.           zr% = -245
  865.           Exit Sub
  866.         Case 26436 '"Dg"
  867.           con.Drag vary
  868.         Case 27972 '"Dm"
  869.           con.DragMode = vary
  870.         ''Case 29764 '"Dt"
  871.           ''con.DeviceType = vary
  872.         Case 31044 '"Dy"
  873.           zr% = -245
  874.           Exit Sub
  875.         Case 25925 '"Ee"
  876.           'con.Execute = vary     ' vb3
  877.         Case 28229 '"En"
  878.           con.Enabled = vary
  879.         Case Else
  880.           GoSub settag
  881.         End Select
  882.       Case Is < 73
  883.         Select Case cviat%
  884.         Case 12614 '"F1"
  885.           con.FontBold = vary
  886.         Case 12870 '"F2"
  887.           con.FontItalic = vary
  888.         ''Case 13126 '"F3"
  889.           ''con.FontStyle = vary
  890.         Case 13382 '"F4"
  891.           con.FontStrikethru = vary
  892.         Case 13638 '"F5"
  893.           con.FontTransparent = vary
  894.         Case 13894 '"F6"
  895.           con.FontUnderline = vary
  896.         ''Case 25158 '"Fb"
  897.           ''If con.FillBarColor <> vary Then con.FillBarColor = vary
  898.         Case 25414 '"Fc"
  899.           con.ForeColor = vary
  900.         ''Case 25670 '"Fd"
  901.           ''con.BeginFade = vary
  902.         Case 25926 '"Fe"
  903.           If InStr(vary, "{") = 0 Then con.FileName = FixDriveVx$(vary)    ': DoEvents  causes previous objects to process GotFocus  6-16-93
  904.           GoSub settag
  905.         Case 26182 '"Ff"
  906.           'con.TimeFormat = vary
  907.           timformat% = vary
  908.           GoSub settag
  909.         ''Case 26438 '"Fg"
  910.           ''con.FindString = vary
  911.         Case 26950 '"Fi"
  912.           If con.FillColor <> vary Then con.FillColor = vary
  913.         Case 28230 '"Fn"
  914.           If con.FontName <> vary Then
  915.             con.FontName = vary
  916.             redolist% = yes
  917.           End If
  918.         ''Case 28486 '"Fo"
  919.           ''con.EndFade = vary
  920.         Case 29510 '"Fs"
  921.           If con.FontSize <> vary Then
  922.             con.FontSize = vary
  923.             redolist% = yes
  924.           End If
  925.         ''Case 29766 '"Ft"
  926.           ''con.Format = vary
  927.         ''Case 30022 '"Fu"
  928.           ''con.FullScreen = vary
  929.         ''Case 30278 '"Fv"
  930.           ''con.FillValue = vary
  931.         ''Case 30790 '"Fx"
  932.           ''con.FoundIndex = vary
  933.         Case 31046 '"Fy"
  934.           con.FillStyle = vary
  935.         ''Case 31302 '"Fz"
  936.           ''con.Focus = vary
  937.         ''Case 28743 '"Gp"
  938.           ''con.Group = vary
  939.         ''Case 29511 '"Gs"
  940.           ''con.GaugeStyle = vary
  941.         ''Case 25672 '"Hd"
  942.           ''con.StateButton = vary
  943.         ''Case 29512
  944.           ''If sys15% >= 0 Then
  945.             ''con.HeadingSize = vary
  946.           ''Else
  947.             ''GoSub settag
  948.           ''End If
  949.         Case 29768 '"Ht"
  950.           If justone% Then
  951.             If TypeOf con Is DriveListBox Then
  952.             Else
  953.               con.Height = vary * Screen.TwipsPerPixelY
  954.             End If
  955.           Else
  956.             ht! = vary * Screen.TwipsPerPixelY
  957.             If con.Height <> ht! Then moveit% = yes
  958.           End If
  959.         Case Else
  960.           GoSub settag
  961.         End Select
  962.       Case Is < 79
  963.         Select Case cviat%
  964.         ''Case 24905 '"Ia"
  965.           ''con.ColAlignment = vary
  966.           ''con.Refresh               ' forces update with new alignment
  967.         ''Case 25161 '"Ib"
  968.           ''con.InnerBottom = vary
  969.         Case 25673 '"Id"
  970.           If (op% And 8) = 0 Then GoSub settag
  971.         Case 25929 '"Ie"
  972.           con.List(lookat%) = vary
  973.         Case 26953 '"Ii"
  974.           con.ListIndex = vary
  975.         ''Case 27465 '"Ik"
  976.           ''If con.TextColor <> vary Then
  977.             ''con.TextColor = vary
  978.             ''If obj% = 108 Then
  979.               ''For y% = con.ListCount - 1 To 0 Step -1
  980.                 ''con.ListTextColor(y%) = vary
  981.               ''Next
  982.             ''End If
  983.           ''End If
  984.         ''Case 27721 '"Il"
  985.           ''con.InnerLeft = vary
  986.         Case 27977, 27201 '"Im", "Aj"
  987.           If Len(vary) = 0 Or justone% <> 0 Then
  988.             GoSub comboitems
  989.           Else                      ' else going to have to redo list anyhow
  990.             redolist% = yes
  991.           End If
  992.           GoSub settag
  993.         ''Case 28745 '"Ip"
  994.           ''con.InnerTop = vary
  995.         ''Case 29257 '"Ir"
  996.           ''con.InnerRight = vary
  997.         ''Case 29513 '"Is"
  998.           ''If aas% = 0 Then con.EndLoop = vary
  999.         ''Case 29769 '"It"
  1000.           ''con.Mask = vary
  1001.         ''Case 31305 '"Iz"
  1002.           ''con.Indent = vary
  1003.         ''Case 28746 '"Jp"
  1004.           ''con.JumpCursor = vary
  1005.         Case 24908 '"La"
  1006.           lookat% = vary
  1007.         ''Case 25420 '"Lc"
  1008.           ''con.LightColor = vary
  1009.         ''Case 29260 '"Lr"
  1010.           ''con.FontOrientation = vary * 10
  1011.         Case 29516 '"Ls"
  1012.           con.LargeChange = vary
  1013.         Case 29772 '"Lt"
  1014.           If justone% Then
  1015.             con.Left = vary * Screen.TwipsPerPixelX
  1016.           Else
  1017.             lt! = vary * Screen.TwipsPerPixelX
  1018.             If con.Left <> lt! Then moveit% = yes
  1019.           End If
  1020.         ''Case 25677 '"Md"
  1021.           ''con.MaxDrop = vary
  1022.         Case 27725 '"Ml"
  1023.           If con.MultiLine <> vary Then
  1024.             con.MultiLine = vary
  1025.           End If
  1026.         Case 28237 '"Mn"
  1027.           con.Min = vary
  1028.         Case 28749 '"Mp"
  1029.           con.MousePointer = vary
  1030.         Case 30285 '"Mv"
  1031.           ReDim mtemp(4): sep$ = vary
  1032.           Call parseintx(0, sep$, mtemp())
  1033.           Select Case mtemp(0)
  1034.           Case 1
  1035.             con.Move Screen.TwipsPerPixelX * mtemp(1)
  1036.           Case 2
  1037.             con.Move Screen.TwipsPerPixelX * mtemp(1), Screen.TwipsPerPixelY * mtemp(2)
  1038.           Case 3
  1039.             con.Move Screen.TwipsPerPixelX * mtemp(1), Screen.TwipsPerPixelY * mtemp(2), Screen.TwipsPerPixelX * mtemp(3)
  1040.           Case 4
  1041.             If TypeOf con Is DriveListBox Then
  1042.               con.Move Screen.TwipsPerPixelX * mtemp(1), Screen.TwipsPerPixelY * mtemp(2), Screen.TwipsPerPixelX * mtemp(3)
  1043.             Else
  1044.               con.Move Screen.TwipsPerPixelX * mtemp(1), Screen.TwipsPerPixelY * mtemp(2), Screen.TwipsPerPixelX * mtemp(3), Screen.TwipsPerPixelY * mtemp(4)
  1045.             End If
  1046.           End Select
  1047.         Case 30797 '"Mx"
  1048.           con.Max = vary
  1049.         ''Case 28750 '"Np"
  1050.           ''con.NormalCursor = vary
  1051.         Case Else
  1052.           GoSub settag
  1053.         End Select
  1054.       Case Is < 82
  1055.         Select Case cviat%
  1056.         ''Case 29263 '"Or"
  1057.           ''con.Orientation = vary
  1058.         Case 29519 '"Os"
  1059.           con.BorderStyle = vary
  1060.         Case 12368 '"P0"
  1061.           If Len(vary) > 1 Then
  1062.             GoSub picfyle2
  1063.             con.Picture = LoadPicture(sep$)
  1064.           End If
  1065.         ''Case 12624 '"P1"
  1066.           ''If Len(vary) > 1 Then
  1067.             ''GoSub picfyle2
  1068.             ''con.PictureDown = LoadPicture(sep$)
  1069.           ''End If
  1070.         ''Case 12880 '"P2"
  1071.           ''If Len(vary) > 1 Then
  1072.             ''GoSub picfyle2
  1073.             ''con.PictureGreyed = LoadPicture(sep$)
  1074.           ''End If
  1075.         ''Case 13136 '"P3"
  1076.           ''If Len(vary) > 1 Then
  1077.             ''GoSub picfyle2
  1078.             ''con.PictureChecked = LoadPicture(sep$)
  1079.           ''End If
  1080.         ''Case 13392 '"P4"
  1081.           ''If Len(vary) > 1 Then
  1082.             ''GoSub picfyle2
  1083.             ''con.PictureUnChecked = LoadPicture(sep$)
  1084.           ''End If
  1085.         ''Case 13648 '"P5"
  1086.           ''If Len(vary) > 1 Then
  1087.             ''GoSub picfyle2
  1088.             ''con.PicturePressed = LoadPicture(sep$)
  1089.           ''End If
  1090.         ''Case 13904 '"P6"
  1091.           ''If Len(vary) > 1 Then
  1092.             ''GoSub picfyle2
  1093.             ''con.PictureUp = LoadPicture(sep$)
  1094.           ''End If
  1095.         ''Case 14672 '"P9"
  1096.           ''If Len(vary) > 1 Then
  1097.             ''GoSub picfyle2
  1098.             ''con.Picture = LoadPicture(sep$)
  1099.             ''con.AutoRedraw = yes
  1100.           ''End If
  1101.         ''Case 25424 '"Pc"
  1102.           ''con.PassChar = vary
  1103.         ''Case 25680 '"Pd"
  1104.           ''If InStr(vary, period$) Then
  1105.             ''con.PictureDown = LoadPicture(FixDriveVx$(vary))
  1106.           ''ElseIf Val(vary) > 0 Then
  1107.             ''con.PictureDown = con.Parent.PicBin.GraphicCell(vary - 1)
  1108.           ''ElseIf vary = "0" Then
  1109.             ''con.PictureDown = LoadPicture("")
  1110.           ''End If
  1111.           ''GoSub settag
  1112.         ''Case 26192 '"Pf"
  1113.           ''If InStr(vary, "{") = 0 Then
  1114.             ''z$ = vary
  1115.             ''GoSub intags        ' get name of prev picture
  1116.             ''If vary <> z$ Or Len(z$) = 0 Then con.LoadPicture = FixDrivex$(z$)
  1117.             ''vary = z$
  1118.           ''End If
  1119.           ''GoSub settag
  1120.         ''Case 26448 '"Pg"
  1121.           ''If InStr(vary, period$) Then
  1122.             ''con.PictureGreyed = LoadPicture(FixDriveVx$(vary))
  1123.           ''ElseIf Val(vary) > 0 Then
  1124.             ''con.PictureGreyed = con.Parent.PicBin.GraphicCell(vary - 1)
  1125.           ''ElseIf vary = "0" Then
  1126.             ''con.PictureGreyed = LoadPicture("")
  1127.           ''End If
  1128.           ''GoSub settag
  1129.         ''Case 26960 '"Pi"
  1130.           ''If InStr(vary, period$) Then
  1131.             ''con.Picture = LoadPicture(FixDriveVx$(vary))
  1132.           ''ElseIf Val(vary) > 0 Then
  1133.             ''con.Picture = con.Parent.PicBin.GraphicCell(vary - 1)
  1134.           ''ElseIf vary = "0" Then
  1135.             ''con.Picture = LoadPicture("")
  1136.           ''End If
  1137.           ''GoSub settag
  1138.         ''Case 27472 '"Pk"
  1139.           ''If InStr(vary, period$) Then
  1140.             ''con.PictureChecked = LoadPicture(FixDriveVx$(vary))
  1141.           ''ElseIf Val(vary) > 0 Then
  1142.             ''con.PictureChecked = con.Parent.PicBin.GraphicCell(vary - 1)
  1143.           ''ElseIf vary = "0" Then
  1144.             ''con.PictureChecked = LoadPicture("")
  1145.           ''End If
  1146.           ''GoSub settag
  1147.         ''Case 27728 '"Pl"
  1148.           ''con.Protocol = vary
  1149.         ''Case 28240 '"Pn"
  1150.           ''If InStr(vary, period$) Then
  1151.             ''con.PictureUnChecked = LoadPicture(FixDriveVx$(vary))
  1152.           ''ElseIf Val(vary) > 0 Then
  1153.             ''con.PictureUnChecked = con.Parent.PicBin.GraphicCell(vary - 1)
  1154.           ''ElseIf vary = "0" Then
  1155.             ''con.PictureUnChecked = LoadPicture("")
  1156.           ''End If
  1157.           ''GoSub settag
  1158.         ''Case 29008 '"Pq"
  1159.           ''con.PopupCursor = vary
  1160.         ''Case 28752 '"Pp"
  1161.           ''If InStr(vary, period$) Then
  1162.             ''con.PicturePressed = LoadPicture(FixDriveVx$(vary))
  1163.           ''ElseIf Val(vary) > 0 Then
  1164.             ''con.PicturePressed = con.Parent.PicBin.GraphicCell(vary - 1)
  1165.           ''ElseIf vary = "0" Then
  1166.             ''con.PicturePressed = LoadPicture("")
  1167.           ''End If
  1168.           ''GoSub settag
  1169.         Case 29264 '"Pr"
  1170.           con.Interval = vary * 1000
  1171.         ''Case 29776 '"Pt"
  1172.           ''con.Position = vary
  1173.         ''Case 30032 '"Pu"
  1174.           ''If InStr(vary, period$) Then
  1175.             ''con.PictureUp = LoadPicture(FixDriveVx$(vary))
  1176.           ''ElseIf Val(vary) > 0 Then
  1177.             ''con.PictureUp = con.Parent.PicBin.GraphicCell(vary - 1)
  1178.           ''ElseIf vary = "0" Then
  1179.             ''con.PictureUp = LoadPicture("")
  1180.           ''End If
  1181.           ''GoSub settag
  1182.         ''Case 31056 '"Py"
  1183.           ''con.Play = vary
  1184.           ''If extt.wind = 0 Then GoSub settag
  1185.         Case Else
  1186.           GoSub settag
  1187.         End Select
  1188.       Case Is < 84
  1189.         Select Case cviat%
  1190.         Case 26706 '"Rh"
  1191.           con.Width = Screen.TwipsPerPixelX * (vary - con.Left \ Screen.TwipsPerPixelX)
  1192.         ''Case 26962 '"Ri"
  1193.           ''If vary < 0 Then
  1194.             ''con.ClearBox = 0
  1195.           ''Else
  1196.             ''con.RemoveItem vary
  1197.           ''End If
  1198.         Case 28498 '"Ro"
  1199.           If extt.wind = 0 Then
  1200.             GoSub settag
  1201.           Else
  1202.             con.ReadOnly = vary
  1203.           End If
  1204.         ''Case 30546 '"Rw"
  1205.           ''con.Rows = vary
  1206.           ''con.Parent.PicBin.Rows = vary
  1207.         ''Case 25171 '"Sb"
  1208.           ''If con.ScrollBars <> vary Then
  1209.             ''con.ScrollBars = vary
  1210.           ''End If
  1211.         ''Case 25427 '"Sc"
  1212.           ''con.ShadowColor = vary
  1213.         ''Case 25683 '"Sd"
  1214.           ''con.Device = vary
  1215.         Case 26707 '"Sh"
  1216.           con.Shape = vary
  1217.         ''Case 26963 '"Si"
  1218.           ''con.Silent = vary
  1219.         ''Case 27475 '"Sk"
  1220.           ''con.SourceDoc = vary
  1221.         Case 27731 '"Sl"
  1222.           If con.Style <> vary Then
  1223.             con.Style = vary
  1224.             redolist% = yes
  1225.             vary = con.Style
  1226.           End If
  1227.         ''Case 27987 '"Sm"
  1228.           ''con.SourceItem = vary
  1229.         ''Case 28499 '"So"
  1230.           ''con.Sound = FixDriveVx$(vary)
  1231.         Case 29011 '"Sq"
  1232.           ReDim mtemp(5): sep$ = vary
  1233.           Call parseintx(0, sep$, mtemp())
  1234.           If mtemp(0) = 5 Then
  1235.             If obj% = 50 Then
  1236.               'wind% = Val(con.Parent.Tag)
  1237.               'Ls(wind%).ScaleMode = mtemp(1)
  1238.               'Ls(wind%).Scale (mtemp(2), mtemp(3))-(mtemp(4), mtemp(5))
  1239.               GoSub settag
  1240.             Else
  1241.               con.ScaleMode = mtemp(1)
  1242.               con.Scale (mtemp(2), mtemp(3))-(mtemp(4), mtemp(5))
  1243.             End If
  1244.           End If
  1245.         Case 28755 '"Sp"
  1246.           con.SmallChange = vary
  1247.         Case 29267 '"Sr"
  1248.           If con.Sorted <> vary Then
  1249.             'If TypeOf con Is Mh3dList Then cap$ = con.Caption
  1250.             If obj% = 108 Then cap$ = con.Caption
  1251.             con.Sorted = vary
  1252.             redolist% = yes
  1253.             vary = con.Sorted
  1254.             'If TypeOf con Is Mh3dList Then con.Caption = cap$
  1255.             If obj% = 108 Then con.Caption = cap$
  1256.           End If
  1257.         Case 29779 '"St"
  1258.           con.Value = vary
  1259.         Case 30035 '"Su"                      ' write only attribute
  1260.           If vary <> 0 Then con.SetFocus : usedsf% = yes
  1261.           If vary > 0 Then DoEvents           ' let gf%() be updated
  1262.         ''Case 30547 '"Sw"
  1263.           ''con.ServerShow = vary
  1264.         Case 30803 '"Sx"
  1265.           con.SelText = vary
  1266.         ''Case 31059 '"Sy"
  1267.           ''con.ServerType = vary
  1268.         ''Case 31315 '"Sz"
  1269.           ''con.ServerClass = vary
  1270.         Case 10323 '"S("
  1271.           con.SelStart = vary
  1272.         Case 10579 '"S)"
  1273.           con.SelLength = vary
  1274.         Case Else
  1275.           GoSub settag
  1276.         End Select
  1277.       Case Else
  1278.         Select Case cviat%
  1279.         ''Case 12628 '"T1"
  1280.           ''If con.HighColor <> vary Then con.HighColor = vary
  1281.         ''Case 12884 '"T2"
  1282.           ''If con.SelectedColor <> vary Then con.SelectedColor = vary
  1283.         ''Case 24916 '"Ta"
  1284.           ''sep$ = vary: y9% = 45
  1285.           ''con.Screenupdate = 0
  1286.           ''z9% = con.ListCount: w9% = con.ListIndex
  1287.           ''For y% = 1 To z9%
  1288.             ''x9% = MhASCIIMid%(sep$, y%)
  1289.             ''If x9% >= 0 Then y9% = x9%
  1290.             ''Select Case y9%
  1291.             ''Case 32, 48, 79, 111
  1292.               ''con.Tagged(y% - 1) = 0
  1293.             ''Case Is <> 45
  1294.               ''con.Tagged(y% - 1) = yes
  1295.             ''End Select
  1296.           ''Next
  1297.           ''con.ListIndex = w9%
  1298.           ''con.Screenupdate = yes
  1299.         'Case 25428 '"Tc"                     ' read-only
  1300.         ''Case 25684 '"Td"
  1301.           ''con.Tagged(lookat%) = vary
  1302.         Case 26452 '"Tg"                      ' all custom Summit attributes are in Tag
  1303.           con.Tag = vary
  1304.         Case 26964 '"Ti"
  1305.           con.TopIndex = vary
  1306.         ''Case 27732 '"Tl"
  1307.           ''con.TextLen = vary
  1308.         Case 28500 '"To"
  1309.           con.TabIndex = vary
  1310.         Case 28756 '"Tp"
  1311.           If justone% Then
  1312.             con.Top = vary * Screen.TwipsPerPixelY
  1313.           Else
  1314.             tp! = vary * Screen.TwipsPerPixelY
  1315.             If con.Top <> tp! Then moveit% = yes
  1316.           End If
  1317.         Case 29524 '"Ts"
  1318.           con.TabStop = vary
  1319.         Case 29780 '"Tt"
  1320.           ''If TypeOf con Is Mh3dCombo Then
  1321.             ''If con.Style <> 2 Then con.Text = vary    ' when style = 2 .text is r/o
  1322.           ''ElseIf TypeOf con Is HEVBLayer Then
  1323.             ''If rtfloaded% = 0 Then con.Text = vary
  1324.           ''Else
  1325.             con.Text = vary
  1326.           ''End If
  1327.         Case 31060 '"Ty"
  1328.           If con.MultiSelect <> vary Then
  1329.             con.MultiSelect = vary
  1330.           End If
  1331.         Case 25685 '"Ud"
  1332.           If vary Then con.Refresh
  1333.         Case 24918 '"Va"
  1334.           con.Value = vary
  1335.         ''Case 25174 '"Vb"
  1336.           ''con.Verb = vary
  1337.         Case 25942 '"Ve"
  1338.           con.Visible = vary
  1339.         Case 26198 '"Vf"
  1340.           If InStr(vary, "{") = 0 Then con.Picture = LoadPicture(FixDriveVx$(vary))
  1341.           GoSub settag
  1342.         ''Case 29782 '"Vt"
  1343.           ''con.VAlignment = vary
  1344.         Case 26711 '"Wh"
  1345.           If justone% Then
  1346.             con.Width = vary * Screen.TwipsPerPixelX
  1347.           Else
  1348.             wh! = vary * Screen.TwipsPerPixelX
  1349.             If con.Width <> wh! Then moveit% = yes
  1350.           End If
  1351.         ''Case 29271 '"Wr"
  1352.           ''con.WallPaper = vary
  1353.         Case 30551 '"Ww"
  1354.           con.WordWrap = vary
  1355.         Case 22616 '"XX"                         ' end instance info
  1356.           If Which% < 0 Then Exit For
  1357.         Case 12378 '"Z0"
  1358.           'con.SetFocus
  1359.           con.ZOrder vary
  1360.         Case 24922 '"Za"
  1361.           zaflag% = yes
  1362.           buf2$ = vary
  1363.           Call copx(65, obj%, con, buf2$, waste&, vary)
  1364.           zaflag% = 0
  1365.         Case 25946 '"Ze"
  1366.           con.Visible = (vary And 1)
  1367.           con.Enabled = (vary And 2)
  1368.           'If (vary And 8) = 0 Then
  1369.           '  con.ZOrder Abs((vary And 4) <> 0)
  1370.           'End If
  1371.           If (vary And 4) Then con.SetFocus
  1372.           If (vary And 8) Then con.Refresh
  1373.         Case 28506 '"Zo"
  1374.           If extt.wind <> 0 And justone% <> 0 Then
  1375.             If vary >= 0 Then con.ZOrder vary
  1376.           End If
  1377.           'If extt.wind = 0 Or justone% <> 0 Then GoSub settag
  1378.           GoSub settag
  1379.         Case Else
  1380.           GoSub settag
  1381.         End Select
  1382.       End Select
  1383. skip2:
  1384.     Next
  1385.     If redolist% = 0 Then
  1386.     ''ElseIf TypeOf con Is Mh3dCombo Then
  1387.       ''GoSub redocombo
  1388.     ''ElseIf obj% = 108 Then
  1389.       ''GoSub redocombo
  1390.     End If
  1391.     If moveit% Then
  1392.       If TypeOf con Is DriveListBox Then
  1393.         con.Move lt!, tp!, wh!
  1394.       Else
  1395.         con.Move lt!, tp!, wh!, ht!
  1396.       End If
  1397.     End If
  1398.     If (op% And 8) = 1 Then at$ = "Id": GoSub intags    ' return ID# in vary
  1399.   End Select
  1400.   '''If sys15% < 0 Then Call sumerr(zr%)
  1401. Exit Sub
  1402.  
  1403.  
  1404.  
  1405. redocombo:
  1406.   at$ = "Im": GoSub intags
  1407.   If Len(vary) = 0 Then Return      ' else fall through
  1408. comboitems:
  1409.   ''con.Screenupdate = 0
  1410.   ''con.ClearBox = 0
  1411.   ''sep$ = Left$(vary, 1)
  1412.   ''If Len(sep$) Then
  1413.     ''impt% = 2
  1414.     ''Do
  1415.       ''impt2% = InStr(impt%, vary, sep$): If impt2% = 0 Then impt2% = Len(vary) + 1
  1416.       ''con.AddItem Mid$(vary, impt%, impt2% - impt%)
  1417.       ''impt% = impt2% + 1
  1418.     ''Loop While impt% <= Len(vary)
  1419.   ''End If
  1420.   ''con.Screenupdate = yes
  1421.   Return
  1422.  
  1423. dumfocus:
  1424.   ''wasignore% = ignoreerr%: ignoreerr% = yes
  1425.   ''Ls(extt.wind).focusdummy.SetFocus
  1426.   ''ignoreerr% = wasignore%
  1427.   Return
  1428.  
  1429. intags:
  1430.   where% = InStr(tags(0, tagval%), at$)
  1431.   If where% Then vary = tags(where% \ 2 + 1, tagval%) Else vary = nul$
  1432.   Return
  1433.  
  1434. picfyle:
  1435.   ''vary = Right$("00" + Hex$(conindex%), 2) + Hex$(sysvar(130)) + vary
  1436.   ''vary = CStr(extt.wind) + Chr$(obj%) + vary
  1437. picfyle2:
  1438.   ''If Len(sysvar(56)) Then
  1439.     ''sep$ = MhSpecToken$(3, FixDriveV$(sysvar(56))) + vary
  1440.   ''Else
  1441.     ''sep$ = mainpath$ + vary
  1442.   ''End If
  1443.   Return
  1444.  
  1445. settag:
  1446.   where% = InStr(tags(0, tagval%), at$)
  1447.   If where% = 0 Then tags(0, tagval%) = tags(0, tagval%) + at$: where% = Len(tags(0, tagval%)) - 1
  1448.   tags(where% \ 2 + 1, tagval%) = vary
  1449.   Return
  1450.  
  1451. whoops:
  1452.   If ignoreerr% Then Resume Next
  1453.   zr% = Err
  1454.   ''zrs$ = "Attribute: " + at$ + ", " + FnAtFind(0, at$)
  1455.   If (op% And 1) Then zrs$ = zrs$ + crlf$ + "Illegal Value: " & vary
  1456.   MsgBox Str$(zr%) + at$ + zrs$, 4096
  1457.   Resume Next
  1458.  
  1459. ignorecop:
  1460.   If buf$ = "Cy" Then
  1461.     sep$ = Error$
  1462.     conindex% = Val(Mid$(sep$, InStr(sep$, "'") + 1))
  1463.   Else
  1464.     conindex% = 1
  1465.   End If
  1466.   Resume Next
  1467.  
  1468. End Sub
  1469.  
  1470. Sub extmgrx (op%, em$)
  1471. ' op% = 1: process incoming em$ execute string
  1472.  
  1473. chr0$ = Chr$(0)
  1474. If op% = 1 Then
  1475.  
  1476. ' first put chr 0 at proper places in em$
  1477.  
  1478.   u& = Val(Left$(em$, 5))                       ' get chr0$ sub technique
  1479.   If u& < 0 Then                                ' < 0 means sub code
  1480.     subchar% = Abs(u&)
  1481.     em$ = MhReplaceChar$(em$, subchar%, 0)      ' replace sub with 0
  1482.   Else
  1483.     zl$ = Mid$(em$, headlen1% + u&)             ' header + em$ to start of zl$
  1484.     Do                                          ' loop through zero list
  1485.       make0% = Val(zl$): If make0% <= 0 Then Exit Do
  1486.       Mid$(em$, make0%) = chr0$
  1487.       pt% = InStr(zl$, chr124$): If pt% = 0 Then Exit Do
  1488.       zl$ = Mid$(zl$, pt% + 1)
  1489.     Loop
  1490.   End If
  1491.  
  1492. ' load em$ header into extt
  1493.  
  1494.   ext36.x = em$: LSet extt = ext36
  1495.   If extt.stl > 0 Then                          ' if there is string info
  1496.     em$ = Mid$(em$, headlen1%, extt.stl)        ' this is the string
  1497.     ept& = 1
  1498.     buf$ = fnExtx(em$, ept&)                    ' uncompress the string
  1499.     vary = fnExtx(em$, ept&)                    ' there are actually two
  1500.   End If
  1501.  
  1502. ' copy commonly used vars from header
  1503.   
  1504.   wind% = extt.wind                             ' Everest window number
  1505.   obj% = extt.obj And 7                         ' object code number
  1506.   op% = extt.op                                 ' desired operation
  1507.   ind% = extt.ind                               ' object ID# in Everest
  1508.   zr% = extt.err                                ' current error code
  1509.  
  1510. ' perform the action indicated by extt.rout
  1511. 'icfiles!Label1.Caption = Str$(Len(em$)) + Str$(Timer)
  1512.  
  1513.   Select Case extt.rout                         ' desired routine
  1514.   Case 2                                        ' call control operations
  1515.     localid% = mapid%(2, wind%, obj%, ind%)
  1516.     'If localid% <= 0 Then zr% = -246: buf$ = Str$(localid%): GoTo returning
  1517.     Select Case obj%                            ' diff call needed for each object
  1518.     Case 0
  1519.       Call copx(op%, obj%, icfiles.Drive1(localid%), buf$, waste&, vary)
  1520.     Case 1
  1521.       Call copx(op%, obj%, icfiles.Dir1(localid%), buf$, waste&, vary)
  1522.     Case 2
  1523.       Call copx(op%, obj%, icfiles.File1(localid%), buf$, waste&, vary)
  1524.     End Select
  1525.     'If op% = 0 Then
  1526.     '  MsgBox "Zero!", 4096
  1527.     'End If
  1528.     If (op% And 1) Then nochange% = yes         ' no new info to return
  1529.   Case 1                                        ' call object manager
  1530.     If op% = 0 Then buf$ = ""
  1531.     Call objmgrx(op%, wind%, obj%, ind%, extt.atx, extt.aty, atscript%, buf$)
  1532.     nochange% = yes
  1533.   Case 0                                        ' send attribute descriptions & help file
  1534.     mainpath$ = buf$                            ' Everest sends path of screen library
  1535.     buf$ = fnCompX(attpick$) + fnCompX(atts$)
  1536.     vary = "Everest1"                           ' must have this signature
  1537.   Case -1                                       ' send object descriptions
  1538.     buf$ = fnCompX(objn$(obj%)) + fnCompX(oats$(obj%)) + fnCompX(roats$(obj%))
  1539.     vary = fnCompX(support$(obj%)) + fnCompX(help$(obj%))
  1540.     If Len(objn$(obj%)) Then icfiles!pic1.Picture = icfiles!Image1(obj%).Picture
  1541.   Case Else                                     ' for future routine codes
  1542.     buf$ = ""
  1543.     vary = ""
  1544.   End Select
  1545.  
  1546. ' prepare return information
  1547.  
  1548. returning:
  1549.  
  1550.   extt.err = zr%: zr% = yes                     ' return error code (if any)
  1551.   If nochange% Then                             ' buf$ & vary not changed
  1552.     extt.stl = -1                               ' flag for no change
  1553.     LSet ext36 = extt                           ' copy to ext36
  1554.     em$ = ext36.x
  1555.   ElseIf Len(buf$) = 0 And Len(vary) = 0 Then
  1556.     extt.stl = 0
  1557.     LSet ext36 = extt                           ' copy to ext36
  1558.     em$ = ext36.x
  1559.   Else
  1560.     chars& = Len(buf$)
  1561.     Select Case chars&
  1562.     Case 0&                   ' null string
  1563.       em$ = Chr$(250) + fnCompX(vary)
  1564.     Case Is < 240&            ' short string
  1565.       em$ = Chr$(chars&) + buf$ + fnCompX(vary)
  1566.     Case Is < 32000           ' medium string, use hex
  1567.       em$ = Chr$(248) + Right$("0000" + Hex$(chars&), 4) & buf$ & fnCompX(vary)
  1568.     Case Else
  1569.       em$ = Chr$(248) + Right$("0000" + Hex$(32000), 4) & Left$(prop, 32000) & fnCompX(vary)
  1570.       extt.err = -277                           ' string too long
  1571.     End Select
  1572.     extt.stl = Len(em$)                         ' string length
  1573.     LSet ext36 = extt                           ' copy to ext36
  1574.     em$ = ext36.x + em$                         ' tack on string
  1575.   End If
  1576.  
  1577. ' now substitute for chr$(0) due to DDE inability to transmit chr$(0)
  1578.  
  1579.   For subchar% = 254 To 1 Step -1               ' look for 0 substitute candidate
  1580.     If InStr(em$, Chr$(subchar%)) = 0 Then Exit For  ' this one not elsewhere in string
  1581.   Next
  1582.   If subchar% Then                              ' sub avail
  1583.     Mid$(em$, 1, 5) = CStr(-subchar%) + "     " ' put sub char at start of em$
  1584.     em$ = MhReplaceChar$(em$, 0, subchar%)      ' quickest
  1585.   Else                                          ' no sub, must create list (slow!)
  1586.     Mid$(em$, 1, 5) = CStr(extt.stl) + "     "  ' save original em$ len
  1587.     pt% = 0
  1588.     Do                                          ' loop & build zero list
  1589.       pt% = InStr(pt% + 1, em$, chr0$)
  1590.       zl$ = zl$ + CStr(pt%) + chr124$
  1591.       Mid$(em$, pt%) = "*"                      ' anything but chr$(0)
  1592.     Loop
  1593.     em$ = em$ + zl$                             ' put zero list on end
  1594.   End If
  1595.  
  1596. ' send reply (Everest is waiting for this)
  1597. 'icfiles!label2.Caption = Str$(Len(em$)) + Str$(Timer)
  1598.  
  1599.   icfiles!Data.Text = em$
  1600.  
  1601. ' the following two apply during an Everest shutdown
  1602.  
  1603.   Select Case extt.rout
  1604.   Case -2                                       ' author removed
  1605.     DoEvents
  1606.     End
  1607.   Case -3                                       ' program ending
  1608.     DoEvents
  1609.     End
  1610.   End Select
  1611. End If
  1612.  
  1613. End Sub
  1614.  
  1615. Function FixColorx& (incolor)
  1616. ' convert hex format incolor string to numeric form
  1617.  
  1618. On Error Resume Next
  1619.   If Len(incolor) >= 10 Then
  1620.     FixColorx& = Val(Left$(incolor, 10))
  1621.   Else
  1622.     z& = Val(incolor)
  1623.     If z& < 0 Then
  1624.       FixColorx& = z& + 65536
  1625.     Else
  1626.       FixColorx& = z&
  1627.     End If
  1628.   End If
  1629.  
  1630. End Function
  1631.  
  1632. Function FixDirx$ (inny$)
  1633. ' convert inny$ subdirectory path to end with : or \
  1634.  
  1635.   pt% = InStr(inny$, "[")
  1636.   If pt% Then                             ' ditch [  ] in path
  1637.     temp$ = RTrim$(Left$(inny$, pt% - 1))
  1638.     pt% = InStr(inny$, "]"): If pt% = 0 Then pt% = Len(inny$)
  1639.     inny$ = temp$ + LTrim$(Mid$(inny$, pt% + 1))
  1640.   End If
  1641.  
  1642.   If Len(inny$) <= 2 Then
  1643.     FixDirx$ = UCase$(inny$)
  1644.   ElseIf Right$(inny$, 1) <> "\" Then
  1645.     FixDirx$ = UCase$(inny$) + "\"
  1646.   Else
  1647.     FixDirx$ = UCase$(inny$)
  1648.   End If
  1649.  
  1650. End Function
  1651.  
  1652. Function FixDriveVx$ (vary As Variant)
  1653. ' call FixDrive, but pass in variant
  1654.  
  1655.   inny$ = vary
  1656.   FixDriveVx$ = FixDrivex$(inny$)
  1657.  
  1658. End Function
  1659.  
  1660. Function FixDrivex$ (inny$)
  1661. ' adjust disk path of file from Everest specifications
  1662. ' if no path, prefix MAINPATH$
  1663. ' if drive letter is ?, replace with MAINPATH$ drive letter
  1664. ' if drive letter is @, replace with current DOS default path
  1665. ' if drive letter is &, replace with Windows path
  1666.  
  1667.   char1% = MhASCIIMid%(inny$, 1)
  1668.   char2% = MhASCIIMid%(inny$, 2)
  1669.   If char1% = 92 And char2% = 92 Then       ' \\network\sharename\sub\filename
  1670.     FixDrivex$ = inny$
  1671.   ElseIf char2% <> 58 Then                  ' not colon$  ":"
  1672.     If Len(inny$) Then FixDrivex$ = mainpath$ + inny$
  1673.   Else
  1674.     char3% = MhASCIIMid%(inny$, 3)
  1675.     Select Case char1%
  1676.     Case 63           ' "?"
  1677.       If char3% = 92 Then
  1678.         FixDrivex$ = Left$(mainpath$, 1) + Mid$(inny$, 2)
  1679.       Else
  1680.         FixDrivex$ = mainpath$ & Mid$(inny$, 3)
  1681.       End If
  1682.     Case 64           ' "@"
  1683.       If char3% = 92 Then
  1684.         FixDrivex$ = Left$(CurDir$, 1) + Mid$(inny$, 2)
  1685.       Else
  1686.         FixDrivex$ = FixDirx$(CurDir$) + MhSpecToken$(6, inny$)
  1687.       End If
  1688.     Case 38           ' "&"
  1689.       If char3% = 92 Then
  1690.         FixDrivex$ = Left$(MhWinDir$(), 1) + Mid$(inny$, 2)
  1691.       Else
  1692.         FixDrivex$ = FixDirx$(MhWinDir$()) + MhSpecToken$(6, inny$)
  1693.       End If
  1694.     Case Else
  1695.       FixDrivex$ = inny$
  1696.     End Select
  1697.   End If
  1698.  
  1699.  
  1700. End Function
  1701.  
  1702. Function fnCompX$ (prop As Variant)
  1703. ' "compress" prop into a string (for object property storage)
  1704. ' this is the opposite of fnExtx
  1705.  
  1706. typ% = VarType(prop)
  1707.  
  1708. If typ% < 2 Then            ' 240=empty, 241=Null
  1709.   fnCompX$ = Chr$(240 + typ%)
  1710. ElseIf typ% = 8 Then        ' string
  1711.   chars& = Len(prop)
  1712.   Select Case chars&
  1713.   Case 0&                   ' null string
  1714.     fnCompX$ = Chr$(250)
  1715.   Case Is < 240&            ' short string
  1716.     fnCompX$ = Chr$(chars&) + prop
  1717.   Case Is < 32000           ' medium string, use hex
  1718.     fnCompX$ = Chr$(248) + Right$("0000" + Hex$(chars&), 4) & prop
  1719.   Case Else
  1720.     fnCompX$ = Chr$(248) + Right$("0000" + Hex$(32000), 4) & Left$(prop, 32000)
  1721.     zr% = -277
  1722.   End Select
  1723. ElseIf typ% < 7 And prop = 0 Then   ' numeric 0
  1724.   fnCompX$ = Chr$(251)
  1725. ElseIf typ% = 2 Then            ' int (short)
  1726.   t242.i = prop: LSet t242s = t242
  1727.   fnCompX$ = t242s.s
  1728. ElseIf typ% = 3 Then        ' int (long)
  1729.   t243.l = prop: LSet t243s = t243
  1730.   fnCompX$ = t243s.s
  1731. ElseIf typ% = 4 Then        ' single
  1732.   t244.s = prop: LSet t244s = t244
  1733.   fnCompX$ = t244s.s
  1734. ElseIf typ% = 5 Then        ' double
  1735.   t245.d = prop: LSet t245s = t245
  1736.   fnCompX$ = t245s.s
  1737. ElseIf typ% = 6 Then        ' currency
  1738.   t246.c = prop: LSet t246s = t246
  1739.   fnCompX$ = t246s.s
  1740. Else                        ' date (8 bytes) or newtype
  1741.   fnCompX$ = Chr$(240 + typ%) & prop
  1742. End If
  1743.  
  1744. End Function
  1745.  
  1746. Function fnExtx (s$, pt&)
  1747. ' "extend" s$ (uncompress) and return as variant
  1748. ' this is the opposite of fnCompx
  1749.  
  1750. On Error GoTo fnExtxerr
  1751. typ% = Asc(Mid$(s$, pt&, 1)) ': pt& = pt& + 1
  1752.  
  1753. If typ% < 240 Then                  ' short string
  1754.   pt& = pt& + 1
  1755.   fnExtx = Mid(s$, pt&, typ%)
  1756.   pt& = pt& + typ%
  1757. ElseIf typ% = 240 Then              ' empty
  1758.   pt& = pt& + 1
  1759.   fnExtx = Empty
  1760. ElseIf typ% = 250 Then              ' null
  1761.   pt& = pt& + 1
  1762.   fnExtx = ""
  1763. ElseIf typ% = 251 Then              ' 0
  1764.   pt& = pt& + 1
  1765.   fnExtx = 0
  1766. ElseIf typ% = 242 Then              ' int
  1767.   t242s.s = Mid$(s$, pt&, 3): LSet t242 = t242s
  1768.   fnExtx = t242.i
  1769.   pt& = pt& + 3
  1770. ElseIf typ% = 243 Then              ' long
  1771.   t243s.s = Mid$(s$, pt&, 5): LSet t243 = t243s
  1772.   fnExtx = t243.l
  1773.   pt& = pt& + 5
  1774. ElseIf typ% = 244 Then              ' single
  1775.   t244s.s = Mid$(s$, pt&, 5): LSet t244 = t244s
  1776.   fnExtx = t244.s
  1777.   pt& = pt& + 5
  1778. ElseIf typ% = 245 Then              ' double
  1779.   t245s.s = Mid$(s$, pt&, 9): LSet t245 = t245s
  1780.   fnExtx = t245.d
  1781.   pt& = pt& + 9
  1782. ElseIf typ% = 248 Then              ' long string
  1783.   pt& = pt& + 1
  1784.   fnExtx = Mid(s$, pt& + 4, Val("&H" + Mid$(s$, pt&, 4)))
  1785.   pt& = pt& + typ% + 4
  1786. ElseIf typ% = 249 Then              ' very long string
  1787.   pt& = pt& + 1
  1788.   chars& = CLng(Mid$(s$, pt&, 5))
  1789.   fnExtx = Mid(s$, pt& + 5, chars&)
  1790.   pt& = pt& + chars& + 5
  1791. ElseIf typ% = 246 Then              ' currency
  1792.   t246s.s = Mid$(s$, pt&, 9): LSet t246 = t246s
  1793.   fnExtx = t246.c
  1794.   pt& = pt& + 9
  1795. ElseIf typ% = 247 Then              ' date
  1796.   pt& = pt& + 1
  1797.   fnExtx = Mid(s$, pt&, 8)
  1798.   pt& = pt& + 8
  1799. End If
  1800. fnExtxbot:
  1801. Exit Function
  1802.  
  1803. fnExtxerr:
  1804.   fnExtx = ""
  1805.   Resume fnExtxbot
  1806.  
  1807. End Function
  1808.  
  1809. Sub init ()
  1810. '
  1811. ' put your custom attribute descriptions in ATTS$
  1812. ' format is |#x.Description|
  1813. ' where # is a digit from 0 to 9
  1814. '       x is a lower-case letter from a to z
  1815.  
  1816.   atts$ = "|1d.Drive|1p.Pattern|1i.CurrentItem|2p.Path|"
  1817.  
  1818. ' put Attribute window drop down list choices in ATTPICK$
  1819. ' format is |#xItem1,Item2|
  1820. ' where #x is the same identifier used in ATTS$
  1821. ' for color dialog, make Item1 Color
  1822. ' for font dialog, make Item1 Font
  1823. ' for files dialog, start Item1 with *
  1824.  
  1825.   attpick$ = ""
  1826.  
  1827. ' put your object descriptions here
  1828. '   objn$(#) = object name
  1829. '   oats$(#) = object design time attributes
  1830. '   roats$(#) = additional attributes to be saved with user bookmark
  1831. '   support$(#) = list of external files needed by object, use comma to separate multiple file names
  1832. '   help$(#) = name of on-line author help file (if any)
  1833. ' where # is a number from 0 to 7
  1834.  
  1835.  
  1836. ' Drives
  1837.   objn$(0) = "Drives"
  1838.   'oats$(0) = "TpLtWhHtIdCoXXIyFcBcFnFsF1TsHeYY1d"  ' VB has fontname & fontsize bug in this object
  1839.   oats$(0) = "TpLtWhHtIdCoXXIyFcBcF1TsHeYY1d"
  1840.   roats$(0) = "VeMp"
  1841.   support$(0) = "icfiles.exe,vbrun300.dll"
  1842.   help$(0) = ""
  1843.  
  1844. ' Dir
  1845.   objn$(1) = "DirList"
  1846.   oats$(1) = "TpLtWhHtIdCo2pXXIyFcBcFnFsF1TsHeCe"
  1847.   roats$(1) = "VeMp"
  1848.   support$(1) = "icfiles.exe,vbrun300.dll"
  1849.   help$(1) = ""
  1850.  
  1851. ' FileList
  1852.   objn$(2) = "FileList"
  1853.   oats$(2) = "TpLtWhHtIdCo1p2pXXIyFcBcFnFsF1TsCeDc"
  1854.   roats$(2) = "VeMp"
  1855.   support$(2) = "icfiles.exe,vbrun300.dll"
  1856.   help$(2) = ""
  1857.  
  1858.  
  1859. End Sub
  1860.  
  1861. Function mapid% (op%, wind%, obj%, ind%)
  1862. ' convert the object ID# number used in Everest
  1863.  
  1864. ' op% = 1: create new, return object's index
  1865. '     = 2: look up, return object's index
  1866. '     = 3: unload
  1867. '     = 4: return Ls wind% number given object's ind%
  1868. '     = 5: return Ls ind% number given object's ind%
  1869.  
  1870. look$ = Chr$(254) + Chr$(wind% + 2) + Chr$(ind%)
  1871. If op% = 1 Then
  1872.   x% = InStr(idmap$(obj%), String$(3, 0))
  1873.   If x% = 0 Then
  1874.     x% = Len(idmap$(obj%)) \ 3 + 1
  1875.     idmap$(obj%) = idmap$(obj%) + look$
  1876.   Else
  1877.     Mid$(idmap$(obj%), x%) = look$
  1878.     x% = (x% + 2) \ 3
  1879.   End If
  1880.   mapid% = x%
  1881.  
  1882. ElseIf op% = 2 Then
  1883.   mapid% = (InStr(idmap$(obj%), look$) + 2) \ 3
  1884.  
  1885. ElseIf op% = 3 Then
  1886.   x% = InStr(idmap$(obj%), look$)
  1887.   If x% Then
  1888.     Mid$(idmap$(obj%), x%) = String$(3, 0)
  1889.     x% = (x% + 2) \ 3
  1890.   End If
  1891.   mapid% = x%
  1892.  
  1893. ElseIf op% = 4 Then
  1894.   mapid% = MhASCIIMid%(idmap$(obj%), ind% * 3 - 1) - 2
  1895.  
  1896. ElseIf op% = 5 Then
  1897.   mapid% = MhASCIIMid%(idmap$(obj%), ind% * 3)
  1898.  
  1899. End If
  1900.  
  1901. End Function
  1902.  
  1903. Sub objmgrx (op%, wind%, obj%, ind%, atx As Single, aty As Single, atscript%, o$)
  1904. ' op% = 0: add object to Script & ls(wind%)
  1905. '     = 1: delete object in script line atscript%
  1906. '     = 2: unload object obj% with index ind%
  1907. '     = 3: same as 2
  1908. '     =-1: same as 0, except load into index% 0 (no Script), make sure fromcpb% = -1
  1909. '
  1910. ' len(o$) > 0: loading object specified in screen script
  1911. ' fromcpb% > 0: pasting from cut/paste buffer, >=0 enable & make visible
  1912. ' atx >= 0 And aty >= 0: dragged to ls(wind%) from ToolSet
  1913. '
  1914. waszr% = zr%: zr% = yes
  1915. If op% <= 0 Then
  1916.   wto% = wind%                        ' default
  1917.   If op% = -3 Then                    ' pasting
  1918.     Action% = 2
  1919.   ElseIf op% = -2 Then                ' loading from o$
  1920.     Action% = 1
  1921.   ElseIf op% < 0 Then
  1922.     Action% = op%
  1923.   ElseIf Len(o$) Then                 ' loading from disk
  1924.     Action% = 1
  1925.   ElseIf atx >= 0 And aty >= 0 Then   ' dragged from ToolSet to VisualScreen
  1926.     Action% = 4: copyop% = 0
  1927.   Else                                ' dragged from ToolSet to IconScript, or double clicked on ToolSet
  1928.     '''Action% = 5: copyop% = 1
  1929.     '''atx = Ls(wind%).Width \ 2 \ sysvar(2): aty = Ls(wind%).Height \ 2 \ sysvar(3)
  1930.   End If
  1931.  
  1932.   If Action% < 0 Then
  1933.     Index% = 0
  1934.     opt& = 28
  1935.     z$ = fnExtx(o$, opt&)                            ' skip comment stored with object
  1936.   ElseIf Len(objids$(wind%, obj%)) >= 100 Then        ' up to 99 of each object classs per screen
  1937.     zr% = -239: Exit Sub
  1938.   ElseIf obj% >= 0 Then
  1939.     Class$ = Chr$(obj%)
  1940.     If ind% > 0 Then
  1941.       Index% = ind%
  1942.     Else
  1943.       For Index% = 1 To 99                            ' find avail index (control array)
  1944.         If InStr(objids$(wind%, obj%), Chr$(Index%)) = 0 Then
  1945.           Exit For
  1946.         End If
  1947.       Next
  1948.       If Index% > 99 Then zr% = -239: Exit Sub
  1949.     End If
  1950.   Else
  1951.     zr% = -232: zrs$ = CStr(obj%): Exit Sub          ' else bad object number
  1952.   End If
  1953.  
  1954.   If Action% < 0 Then
  1955.   ElseIf Action% = 1 Then
  1956.     opt& = 1: lyn% = atscript%
  1957.   End If
  1958.  
  1959.   If wind% = 0 Or wind% = -1 Then 'And fromcpb% >= 0 Then
  1960.     enable% = yes
  1961.   Else
  1962.     enable% = 0
  1963.   End If
  1964.  
  1965.   cto% = Index%
  1966.  
  1967.   If zr% <> -1 Then obj% = -1
  1968.   If obj% < 0 Then
  1969.     zr% = yes
  1970.   End If
  1971.  
  1972.   If cto% <= 0 Or InStr(objids$(wind%, obj%), Chr$(cto%)) > 0 Then
  1973.     newcon% = 0
  1974.   ElseIf obj% = 76 Then    ' JLabel has no tags
  1975.     newcon% = yes
  1976.   Else
  1977.     newcon% = yes   ' DoEvents  can help with unnecessary focus event
  1978.     newtag = InStr(usedtags$, " ")
  1979.     If newtag = 0 Then
  1980.       usedtags$ = usedtags$ + "X"
  1981.       newtag = Len(usedtags$)
  1982.       If newtag > UBound(tags, 2) Then ReDim Preserve tags(39, newtag + 7)
  1983.     Else
  1984.       Mid(usedtags$, newtag) = "X"
  1985.     End If
  1986.     If newtag < 256 Then newtag = Chr$(newtag) Else newtag = CStr(newtag)
  1987.   End If
  1988.  
  1989.   Select Case obj%
  1990.   Case 0                               ' Drive list
  1991.     If newcon% Then
  1992.       localid% = mapid%(1, wto%, obj%, cto%)
  1993.       Load icfiles.Drive1(localid%)
  1994.       x% = SetParent(icfiles.Drive1(localid%).hWnd, extt.hwn)
  1995.       icfiles.Drive1(localid%).Tag = newtag
  1996.     End If
  1997.     If Action% <= 2 Then                   ' from disk
  1998.       Call copx(1, obj%, icfiles.Drive1(localid%), o$, opt&, vwaste)
  1999.     Else
  2000.       icfiles.Drive1(localid%).Move Screen.TwipsPerPixelX * atx, Screen.TwipsPerPixelY * aty
  2001.     End If
  2002.     If enable% Then
  2003.       icfiles.Drive1(localid%).Enabled = yes
  2004.       icfiles.Drive1(localid%).Visible = yes
  2005.     End If
  2006.  
  2007.   Case 1                               ' Directory list
  2008.     If newcon% Then
  2009.       localid% = mapid%(1, wto%, obj%, cto%)
  2010.       Load icfiles.Dir1(localid%)
  2011.       x% = SetParent(icfiles.Dir1(localid%).hWnd, extt.hwn)
  2012.       icfiles.Dir1(localid%).Tag = newtag
  2013.     End If
  2014.     If Action% <= 2 Then                   ' from disk
  2015.       Call copx(1, obj%, icfiles.Dir1(localid%), o$, opt&, vwaste)
  2016.     Else
  2017.       icfiles.Dir1(localid%).Move Screen.TwipsPerPixelX * atx, Screen.TwipsPerPixelY * aty
  2018.     End If
  2019.     If enable% Then
  2020.       icfiles.Dir1(localid%).Enabled = yes
  2021.       icfiles.Dir1(localid%).Visible = yes
  2022.     End If
  2023.  
  2024.   Case 2                               ' File list
  2025.     If newcon% Then
  2026.       localid% = mapid%(1, wto%, obj%, cto%)
  2027.       Load icfiles.File1(localid%)
  2028.       x% = SetParent(icfiles.File1(localid%).hWnd, extt.hwn)
  2029.       icfiles.File1(localid%).Tag = newtag
  2030.     End If
  2031.     If Action% <= 2 Then                   ' from disk
  2032.       Call copx(1, obj%, icfiles.File1(localid%), o$, opt&, vwaste)
  2033.     Else
  2034.       icfiles.File1(localid%).Move Screen.TwipsPerPixelX * atx, Screen.TwipsPerPixelY * aty
  2035.     End If
  2036.     If enable% Then
  2037.       icfiles.File1(localid%).Enabled = yes
  2038.       icfiles.File1(localid%).Visible = yes
  2039.     End If
  2040.  
  2041.   End Select
  2042.  
  2043.   If obj% >= 0 Then
  2044.     If newcon% Then objids$(wind%, obj%) = objids$(wind%, obj%) + Chr$(cto%)
  2045.     ind% = cto%
  2046.   End If
  2047.  
  2048.  
  2049. ElseIf op% = 1 Or op% = 2 Or op% = 3 Then      ' delete object
  2050.     Index% = ind%
  2051.  
  2052.   localid% = mapid%(3, wind%, obj%, Index%)
  2053.   If localid% > 0 Then
  2054.     Select Case obj%
  2055.     Case 0
  2056.       oldtag$ = icfiles.Drive1(localid%).Tag
  2057.       Unload icfiles.Drive1(localid%)
  2058.     Case 1
  2059.       oldtag$ = icfiles.Dir1(localid%).Tag
  2060.       Unload icfiles.Dir1(localid%)
  2061.     Case 2
  2062.       oldtag$ = icfiles.File1(localid%).Tag
  2063.       Unload icfiles.File1(localid%)
  2064.     End Select
  2065.   Else
  2066.     zr% = -246
  2067.   End If
  2068.  
  2069.   If Len(oldtag$) = 1 Then ot% = Asc(oldtag$) Else ot% = Val(oldtag$)
  2070.   If ot% > 0 Then
  2071.     Mid(usedtags$, ot%) = " "
  2072.     x% = Len(tags(0, ot%)) \ 2 + 1
  2073.     For x% = x% To 0 Step -1: tags(x%, ot%) = Empty: Next
  2074.   End If
  2075.  
  2076.   'If op% = 1 Or op% = 2 Then
  2077.     Index% = InStr(objids$(wind%, obj%), Chr$(Index%))
  2078.     If Index% > 0 Then
  2079.       objids$(wind%, obj%) = Left$(objids$(wind%, obj%), Index% - 1) + Mid$(objids$(wind%, obj%), Index% + 1)
  2080.     End If
  2081.   'End If
  2082.  
  2083. End If
  2084. objmgrbot:
  2085. zr% = waszr%
  2086.  
  2087. End Sub
  2088.  
  2089. Sub parseintx (op%, z$, a() As Variant)
  2090. ' parse comma delimited z$, return pieces in array a()
  2091.  
  2092. maxcount% = UBound(a)
  2093. For Count% = 1 To maxcount%
  2094.   pt% = pt2% + 1: pt2% = InStr(pt%, z$, ",")
  2095.   If pt2% Then
  2096.     p$ = Mid$(z$, pt%, pt2% - pt%)
  2097.   Else
  2098.     p$ = Mid$(z$, pt%)
  2099.   End If
  2100.   valp = Val(p$)
  2101.   If p$ = "0" Or valp <> 0 Then
  2102.     a(Count%) = valp
  2103.   Else
  2104.     a(Count%) = p$
  2105.   End If
  2106.   If pt2% = 0 Then Exit For
  2107. Next
  2108. a(0) = Count%                   ' number of parameters found
  2109.  
  2110. End Sub
  2111.  
  2112. Sub sendevent (evcode$, obj%, ind%, xtra$)
  2113. ' send an event to Everest
  2114. ' uses the eq$() event queue to buffer events
  2115.  
  2116. Static inthissub%
  2117.  
  2118.   eq$(eqin%) = evcode$ + Chr$(obj% + 8) + Chr$(mapid%(4, 0, obj%, ind%) + 8) + Chr$(mapid%(5, 0, obj%, ind%) + 8) + xtra$
  2119.   eqin% = eqin% + 1
  2120.  
  2121.   If eqin% > 127 Then eqin% = 1
  2122.   If inthissub% Then Exit Sub
  2123.   inthissub% = yes
  2124.  
  2125.   Do While eqout% <> eqin%
  2126.     If Len(eq$(eqout%)) Then
  2127.       icfiles.Events.Text = eq$(eqout%)
  2128.       eq$(eqout%) = ""
  2129.       t = Timer + 1: If t > 86400 Then t = 1  ' loop for up to one second
  2130.       Do
  2131.         DoEvents                              ' allow Everest to clear .Text after receiving it
  2132.         If Len(icfiles.Events.Text) = 0 Then Exit Do
  2133.       Loop While Timer < t
  2134.     End If
  2135.     eqout% = eqout% + 1
  2136.     If eqout% > 127 Then eqout% = 1
  2137.   Loop
  2138.  
  2139.   inthissub% = 0
  2140. End Sub
  2141.  
  2142.